home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tsptp.zip
/
ACKERMAN.PAS
next >
Wrap
Pascal/Delphi Source File
|
1993-04-09
|
3KB
|
92 lines
(******************************************************************************)
(* ACK.PAS *)
(* Ackermann benchmark See 'Software Practice and Experince', Vol 7 pp317-329 *)
(* (1977) *)
(******************************************************************************)
PROGRAM ACKERMAN(Output);
(******************************************************************************)
(* TIMING *)
(******************************************************************************)
(*$IFNDEF TopSpeed *)
(*%F TRUE *** Compile for Turbo Pascal ***)
USES TPBench;
(*%E*)
(*$ELSE *** Compile for TopSpeed Pascal ***)
IMPORT TSBench *;
(*$ENDIF *)
(******************************************************************************)
VAR Failed: BOOLEAN;
FUNCTION Ackermann(m, n: BmInt): BmInt;
BEGIN
IF m = 0 THEN
Ackermann := n + 1
ELSE IF n = 0 THEN
Ackermann := Ackermann(m - 1, 1)
ELSE
Ackermann := Ackermann(m - 1, Ackermann(m, n - 1));
END;
PROCEDURE Ack;
VAR i, j, k, k1: BmInt;
BEGIN
k := 16;
k1 := 1;
Failed := FALSE;
FOR i := 1 TO 6 DO
BEGIN
j := Ackermann( 3, i);
IF j <> k - 3 THEN
Failed := TRUE;
(*** The following lines should only be uncommented for debugging.
WriteLn(' NO OF CALLS: ', (512.0 * FLOAT(k1) - 15.0 * FLOAT(k)
+ 9.0 * FLOAT(i) + 37.0)/3.0, 15);
***)
k1 := 4 * k1;
k := 2 * k;
END;
END;
BEGIN
WriteLn('Ackermann Benchmark');
(******************************************************************************)
(* Compute the looping overhead. The Dummy procedure must have some side- *)
(* effect so that it is not optimised out of existence. *)
(******************************************************************************)
StartTimer; (* Start the clock. *)
REPEAT
Dummy;
UNTIL NullTimesUp;
(******************************************************************************)
(* Now run the benchmark. Note that the Dummy procedure is also called so *)
(* that we can eliminate its overhead from the looping overhead. *)
(******************************************************************************)
StartTimer; (* Start the clock. *)
REPEAT
Ack;
Dummy
UNTIL BenchTimesUp;
(******************************************************************************)
ReportTimes;
IF Failed THEN
WriteLn('Fail')
ELSE
WriteLn('Pass');
END.